home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / asize / gpprocs.bas < prev   
BASIC Source File  |  1995-05-09  |  2KB  |  51 lines
  1.  
  2. Function GetTwpsPerPxlX (f1 As Form) As Integer
  3.   Dim xDPI As Integer
  4.   '---Get display's horizontal dots per logical inch, set gTwpsPerPxlX
  5.   xDPI = GetDeviceCaps(f1.hDC, LOGPIXELSX)
  6.   GetTwpsPerPxlX = 1440 / xDPI
  7. End Function
  8.  
  9. Function GetTwpsPerPxlY (f1 As Form) As Integer
  10.   Dim xDPI As Integer
  11.   '---Get display's vertical dots per logical inch, set gTwpsPerPxlY
  12.   yDPI = GetDeviceCaps(f1.hDC, LOGPIXELSY)
  13.   GetTwpsPerPxlY = 1440 / yDPI
  14. End Function
  15.  
  16. Sub Init_Measures (TheForm As Form)
  17.   TheForm.Scalemode = 3
  18.   gTwpsPerPxlX = GetTwpsPerPxlX(TheForm)
  19.   gTwpsPerPxlY = GetTwpsPerPxlY(TheForm)
  20.   SetFont 2, TheForm
  21.   gHStd = TheForm.TextWidth("1")
  22.   gVStd = TheForm.TextHeight("1")
  23.   '---System metrics...
  24.   gSysmet.hgtCapBar = GetSystemMetrics(SM_CYCAPTION)
  25.   gSysmet.hgtFrame = GetSystemMetrics(SM_CYFRAME)
  26.   gSysmet.wthFrame = GetSystemMetrics(SM_CXFRAME)
  27.   gSysmet.hgtMenu = GetSystemMetrics(SM_CYMENU)
  28.   gSysmet.wthArrow = GetSystemMetrics(SM_CXVSCROLL)
  29. End Sub
  30.  
  31. Sub SetFont (FontType As Integer, TheForm As Form)
  32.   Select Case FontType
  33.   Case 1  'Standard Caption bar type - System 10
  34.     TheForm.FontName = "System"
  35.     TheForm.FontSize = 10
  36.   Case 2  'Standard cmd button type - Helv 8.25
  37.     TheForm.FontName = TheForm.txt(0).FontName  'Helv
  38.     TheForm.FontSize = TheForm.txt(0).FontSize  '8.25
  39.   Case 3  'Small Labels - Helv 10
  40.     TheForm.FontName = "Helv"
  41.     TheForm.FontSize = 10
  42.   Case 4  'Medium Labels - Helv 12
  43.     TheForm.FontName = "Helv"
  44.     TheForm.FontSize = 12
  45.   Case 5  'Large Labels - Helv 14
  46.     TheForm.FontName = "Helv"
  47.     TheForm.FontSize = 14
  48.   End Select
  49. End Sub
  50.  
  51.